home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu634.dms / pu634.adf / GENIES / SelectByAttribute.pdrx < prev    next >
Text File  |  1994-09-06  |  15KB  |  403 lines
  1. /*
  2. Copyright 1992 StarTeck. All rights reserved.
  3.  
  4. This Genie will select the objects with the specified attributes.
  5. Just answer prompts...
  6. */
  7. call pdm_AutoUpdate(0)
  8.  
  9. cr = '0a'x
  10.  
  11. commands.1 = "Position"
  12. commands.2 = "Size"
  13. commands.3 = "Line Color"
  14. commands.4 = "Line Pattern"
  15. commands.5 = "Fill Pattern"
  16. commands.6 = "Line Weight"
  17. commands.7 = "Line Join"
  18. commands.8 = "Lock"     /* ProDraw function IsLocked not working */
  19.  
  20. prompt = commands.1
  21.  
  22. do i = 2 to 7
  23.    prompt = prompt || cr || commands.i
  24. end
  25.  
  26. LastUsed = 'NotUsed'
  27. PreviouslyUsed = getclip(PreUsed)
  28. if PreviouslyUsed = ON then do
  29.    LastUsed = pdm_inform(3,'Input selection method...','RE-INPUT','Cancel','LAST USED')
  30.       if LastUsed = 1 then exit_msg()
  31.    end
  32.  
  33. response = ''
  34.  
  35. if LastUsed = 0 | LastUsed = 'NotUsed' then do   
  36.  
  37.    response = pdm_SelectFromList("Select objects by..",15,7,1,prompt)
  38.    if response = '' then exit_msg()
  39.  
  40.    response2 = response
  41.    call setclip(lastusedresponse,response)
  42.  
  43.    do while response2 ~= ''
  44.       parse var response2 command '0a'x response2
  45.  
  46.       select
  47.          when command = commands.1 then do
  48.             testinput = 1
  49.             do while testinput = 1
  50.                posprompt = 'X pos =:' ||cr|| 'Y pos =:'
  51.                checkpos = pdm_getform('Input object location...',7,posprompt)
  52.                if checkpos = '' then exit_msg(position not entered)
  53.                parse var checkpos checkposX (cr) checkposY
  54.                if datatype(checkposX,'N') & datatype(checkposY,'N') then do
  55.                   checkposX = trunc(checkposX,4)
  56.                   checkposY = trunc(checkposY,4)
  57.                   testinput = 0
  58.                   call setClip(ClipCheckposX,checkposX)
  59.                   call setClip(ClipCheckposY,checkposY)
  60.                   end
  61.                end /* do */
  62.             end /* when */
  63.  
  64.  
  65.          when command = commands.2 then do
  66.             testinput = 1
  67.             do while testinput = 1
  68.                sizeprompt = 'X width  =:' ||cr|| 'Y heigth =:'
  69.                checksize = pdm_getform('Input object size...',6,sizeprompt)
  70.                if checksize = '' then exit_msg(size not entered)
  71.                parse var checksize checksizeX (cr) checksizeY
  72.                if datatype(checksizeX,'N') & datatype(checksizeY,'N') then do
  73.                   checksizeX = trunc(checksizeX,4)
  74.                   checksizeY = trunc(checksizeY,4)
  75.                   testinput = 0
  76.                   call setClip(ClipChecksizeX,checksizeX)
  77.                   call setClip(ClipChecksizeY,checksizeY)
  78.                   end
  79.                end /* do while */
  80.             end /* when */
  81.  
  82.  
  83.          when command = commands.3 then do
  84.             call GetColorPalete()
  85.             CheckLineColor = SelectFromList('Input line color to search for...',30,count,2,colorlist)
  86.             if checklinecolor = '' then exit_msg(line color not entered)
  87.             call setClip(ClipCheckLineColor,checkLineColor)
  88.             end
  89.  
  90.  
  91.          when command = commands.4 then do
  92.             CheckLinePtn = inform(3,'Input line pattern to search for...','ProDraw 0-8','Cancel','Custom')
  93.  
  94.             if CheckLinePtn = 1 or ChecklinePtn = '' then exit_msg()
  95.  
  96.             testinput = 1
  97.             if CheckLinePtn = 0 then do
  98.                linenumberlist = 0 ||cr|| 1 ||cr|| 2 ||cr|| 3 ||cr|| 4 ||cr|| 5 ||cr|| 6 ||cr|| 7 ||cr|| 8 
  99.                CheckLinePtn = pdm_selectfromList('Choose Line Pattern number...',29,9,0,LineNumberList)
  100.                if CheckLinePtn = '' then exit_msg()
  101.                end /* if do */
  102.  
  103.              else do while testinput = 1
  104.                lineprompt = 'ON:0.0000' ||cr|| 'OFF:0.0000' ||cr|| 'ON:0.0000' ||cr|| 'OFF:0.0000' ||cr|| 'ON:0.0000' ||cr|| 'OFF:0.0000'
  105.                checklinePtn = pdm_getform('Input line pattern...',7,lineprompt)
  106.                if checklineptn = '' then exit_msg()
  107.  
  108.                onoff. = ''
  109.                parse var CheckLinePtn onoff.1 (cr) onoff.2 (cr) onoff.3 (cr) onoff.4 (cr) onoff.5 (cr) onoff.6
  110.  
  111.                baddata = 1
  112.                do i = 1 to 6 until baddata = 0    /* test loop for bad data */
  113.                   if ~datatype(onoff.i,'N') then 
  114.                      baddata = 0
  115.                    else
  116.                       onoff.i = trunc(onoff.i,4)
  117.                 end /* do i = 1 to 6 until baddata = 0 */
  118.  
  119.                if baddata = 1 then do
  120.                   testinput = 0
  121.                   CheckLinePtn = '-1 'ONOFF.1' 'ONOFF.2' 'ONOFF.3' 'ONOFF.4' 'ONOFF.5' 'ONOFF.6
  122.                   end
  123.                end /* else do while testinput = 1 */
  124.                call setClip(ClipCheckLinePtn,CheckLinePtn)
  125.  
  126.             end /* when */
  127.  
  128.          when command = commands.5 then do
  129.             fillprompt = 'No Fill' ||cr|| 'Solid Fill' ||cr|| 'Radial Fill' ||cr|| 'Linear Fill'
  130.             CheckFillColor = pdm_SelectFromList('Input fill type to search for...',30,3,2,fillprompt)
  131.             if CheckFillColor = '' then exit_msg()
  132.             select
  133.                when CheckFillColor = 'No Fill' then
  134.                   CheckFillColor = 0
  135.  
  136.                when CheckFillColor = 'Solid Fill' then do
  137.                   CheckFillColor = 1
  138.                   call GetColorPalete()
  139.                      CheckFillColor1 = SelectFromList('Input fill color to search for...',30,count,2,colorlist)
  140.                      if checkFillcolor1 = '' then exit_msg(fill color not entered)
  141.                   end
  142.  
  143.                when CheckFillColor = 'Radial Fill' then do
  144.                   CheckFillColor = 2
  145.                   call GetColorPalete()
  146.                      CheckFillColor1 = SelectFromList('Input first radial fill color...',30,count,2,colorlist)
  147.                      if checkFillcolor1 = '' then exit_msg(first radial fill color not entered)
  148.                      CheckFillColor2 = SelectFromList('Input second radial fill color...',30,count,2,colorlist)
  149.                      if checkFillcolor2 = '' then exit_msg(second radial fill color not entered)
  150.                   end
  151.                 
  152.                otherwise /* CheckFillColor = 'Linear Fill' then */
  153.                   CheckFillColor = 3
  154.                   call GetColorPalete()
  155.                      CheckFillColor1 = SelectFromList('Input first linear fill color...',30,count,2,colorlist)
  156.                      if checkFillcolor1 = '' then exit_msg(first linear fill color not entered)
  157.                      CheckFillColor2 = SelectFromList('Input second linear fill color...',30,count,2,colorlist)
  158.                      if checkFillcolor2 = '' then exit_msg(second linear fill color not entered)
  159.                   end /* select inside select */
  160.             call setClip(ClipCheckFillColor,CheckFillcolor)
  161.             call setClip(ClipCheckFillColor1,CheckFillcolor1)
  162.             call setClip(ClipCheckFillColor2,CheckFillcolor2)
  163.             end /* select */
  164.  
  165.  
  166.          when command = commands.6 then do
  167.             lineweightprompt = 'None' ||cr|| 'Hairline' ||cr|| '0.5 point' ||cr|| '1 point' ||cr|| '1.5 points' ||cr|| '2 points' ||cr|| '3 points' ||cr|| '4 points' ||cr|| 'Custom'
  168.             CheckLineWeight = SelectFromList('Input linewieght to search for...',30,9,2,LineWeightprompt)
  169.             if CheckLineWeight = '' then exit_msg()
  170.             select
  171.                when CheckLineWeight = 'None' then
  172.                   ChecklineWeight = 0.00
  173.  
  174.                when CheckLineWeight = 'Hairline' then
  175.                   ChecklineWeight = 0.25
  176.  
  177.                when CheckLineWeight = '0.5 point' then
  178.                   ChecklineWeight = 0.50
  179.  
  180.                when CheckLineWeight = '1 point' then
  181.                   ChecklineWeight = 1.00
  182.  
  183.                when CheckLineWeight = '1.5 points' then
  184.                   ChecklineWeight = 1.50
  185.  
  186.                when CheckLineWeight = '2 points' then
  187.                   ChecklineWeight = 2.00
  188.  
  189.                when CheckLineWeight = '3 points' then
  190.                   ChecklineWeight = 3.00
  191.  
  192.                when CheckLineWeight = '4 points' then
  193.                   ChecklineWeight = 4.00
  194.  
  195.                otherwise /* CheckLineWeight = 'Custom' then */
  196.                   Flag = 1
  197.                   do while flag = 1
  198.                      CheckLineWeight = pdm_getform('Input line weight to search for...',6,'weight in inches = :0.000')
  199.                      call pdm_clearStatus()
  200.                      if CheckLineWeight = '' then exit_msg()
  201.                      if ~datatype(CheckLineWeight,'N') then
  202.                         call pdm_ShowStatus(Invalid input try again...)
  203.                      else do
  204.                         Flag = 0
  205.                         checklineweight = checklineweight * 72
  206.                         checklineweight = trunc(CheckLineWeight+.5e-2,2)
  207.                         end /* else do */
  208.                      end /* do */
  209.                end /* select */
  210.             call setClip(ClipCheckLineWeight,CheckLineWeight)
  211.          end /* when */
  212.  
  213.  
  214.          when command = commands.7 then do
  215.             linejoinprompt = 'Miter' ||cr|| 'Round' ||cr|| 'Bevel' ||cr|| 'Butt'
  216.             CheckLineJoin = SelectFromList('Input line join type to search for...',30,4,2,LineJoinprompt)
  217.             if CheckLineJoin = '' then exit_msg()
  218.             select
  219.                when CheckLineJoin = 'Miter' then
  220.                   CheckLineJoin = 0
  221.  
  222.                when CheckLineJoin = 'Round' then
  223.                   CheckLineJoin = 1
  224.  
  225.                when CheckLineJoin = 'Bevel' then
  226.                   CheckLineJoin = 2
  227.  
  228.                otherwise /* CheckLineJoin = 'Butt' then */
  229.                   CheckLineJoin = 3
  230.                end /* select */
  231.             call setClip(ClipCheckLineJoin,CheckLineJoin)
  232.             end /* when */
  233.  
  234.  
  235. /*   Reserved for when Gold Disk Fixes function IsLocked
  236.         when command = commands.8 then do
  237.         end
  238. */
  239.  
  240.          otherwise
  241.          end /* select */
  242.       call setClip(PreUsed,'ON')
  243.    end /* do while loop */
  244. end /* if LastUsed = 0 or LastUsed = 'NotUsed' */
  245.  
  246. /*!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*/
  247. /*!!!!!!!!!!!!!!!!!!!!!!!!Start Highlighting objects!!!!!!!!!!!!!!!!!!!!!*/
  248. /*!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*/
  249.  
  250. if LastUsed = 2 then do
  251.    CheckposX = getclip(ClipCheckPosX)
  252.    CheckposY = getclip(ClipCheckPosY)
  253.    ChecksizeX = getclip(ClipCheckSizeX)
  254.    ChecksizeY = getclip(ClipCheckSizeY)
  255.    CheckLineColor = getclip(ClipCheckLineColor)
  256.    CheckLinePtn = getclip(ClipChecklinePtn)
  257.    CheckFillColor = getclip(ClipCheckFillcolor)
  258.       CheckFillColor1 = getclip(ClipCheckFillcolor1)
  259.       CheckFillColor2 = getclip(ClipCheckFillcolor2)
  260.    CheckLineWeight = getclip(ClipCheckLineWeight)
  261.    CheckLineJoin = getclip(ClipCheckLineJoin)
  262.    response = getclip(lastUsedResponse)
  263.    end
  264.  
  265.  
  266. do while response ~= ''
  267.    parse var response command '0a'x response
  268.  
  269.    nextobjpg = pdm_PageFirstObj()
  270.    if ~(nextobjpg = 0) then do
  271.    Do until nextobjpg = 0
  272.       select
  273.          when command = commands.1 then do
  274.             currentobjpos = pdm_getobjposn(nextobjpg)
  275.             currentobjposX = word(currentobjpos,1)
  276.             currentobjposY = word(currentobjpos,2)
  277.             if currentobjposx = checkposx & currentobjposy = checkposy then
  278.                call pdm_selectAnother(nextobjpg)
  279.             end /* do */
  280.  
  281.          when command = commands.2 then do
  282.             currentobjsize = pdm_getobjsize(nextobjpg)
  283.             currentobjsizex = word(currentobjsize,1)
  284.             currentobjsizey = word(currentobjsize,2)
  285.             if currentobjsizex = checksizex & currentobjsizey = checksizey then
  286.                call pdm_selectAnother(nextobjpg)
  287.             end
  288.  
  289.          when command = commands.3 then do
  290.             currentobjlinecolor = pdm_getlinecolor(nextobjpg)
  291.             currentobjlineweight = pdm_getlineweight(nextobjpg)
  292.             if ~(currentobjlineweight = 0.00) then do
  293.                if currentobjlinecolor = checklinecolor then
  294.                   call pdm_selectAnother(nextobjpg)
  295.                end
  296.             end
  297.  
  298.          when command = commands.4 then do
  299.             currentobjlineptn = pdm_getlinepattern(nextobjpg)
  300.             patternNum = word(currentobjlineptn,1)
  301.             userpatternNum = word(checkLinePtn,1)
  302.                if userpatternNum = -1 then do
  303.                   patternNum = subword(currentobjlineptn,2)
  304.                   userpatternNum = subword(checkLinePtn,2)
  305.                      if patternNum == userpatternNum then do
  306.                         currentobjlineweight = pdm_getlineweight(nextobjpg)
  307.                         if ~(currentobjlineweight = 0.00) then
  308.                            call pdm_selectAnother(nextobjpg) 
  309.                         end
  310.                   end
  311.                else 
  312.                   currentobjlineweight = pdm_getlineweight(nextobjpg)
  313.                   if ~(currentobjlineweight = 0.00) then
  314.                      if patternNum = userpatternNum then
  315.                         call pdm_selectAnother(nextobjpg) 
  316.             end /* select */
  317.  
  318.         
  319.          when command = commands.5 then do
  320.             currentobjfillptn = pdm_getfillpattern(nextobjpg)
  321.             parse var currentobjfillptn objnum (cr) firstcolor (cr) secondcolor (cr) rest
  322.  
  323.             if word(checkfillcolor,1) = objnum then  
  324.                select
  325.                   when word(checkfillcolor,1) = 0 then /* No Fill */
  326.                      call pdm_selectAnother(nextobjpg) 
  327.  
  328.                   when word(checkfillcolor,1) = 1 then do /* Solid Fill */
  329.                      if checkfillcolor1 = firstcolor then
  330.                         call pdm_selectAnother(nextobjpg) 
  331.                      end
  332.  
  333.                   when word(checkfillcolor,1) = 2 then do /* Radial Fill */
  334.                      if checkfillcolor1 = firstcolor & checkfillcolor2 = secondcolor then
  335.                         call pdm_selectAnother(nextobjpg)
  336.                      end 
  337.  
  338.                   when word(checkfillcolor,1) = 3 then do /* Linear Fill */
  339.                      if checkfillcolor1 = firstcolor & checkfillcolor2 = secondcolor then
  340.                         call pdm_selectAnother(nextobjpg)
  341.                   end
  342.                 
  343.                   otherwise
  344.                end /* select */
  345.             end /* when */
  346.  
  347.          when command = commands.6 then do
  348.             currentobjlineweight = pdm_getlineweight(nextobjpg)
  349.             if currentobjlineweight = checklineweight then
  350.                call pdm_selectAnother(nextobjpg)                
  351.             end
  352.  
  353.          when command = commands.7 then do
  354.             currentobjlinejoin = pdm_getlinejoin(nextobjpg)
  355.             if currentobjlinejoin = checklinejoin then
  356.                call pdm_selectAnother(nextobjpg)    
  357.             end
  358.  
  359. /*       when command = commands.8 then do
  360.             end
  361.  
  362. */
  363.  
  364.          otherwise
  365.          end /* select */
  366.       nextobjpg = pdm_PageNextObj(nextobjpg)
  367.       end /* Do until nextObjpg = 0 */
  368.       end /* if ~(nextobjpg = 0) */
  369.    end /* do while response ~= '' */
  370.  
  371. call exit_msg()
  372.  
  373.  
  374.  
  375.  
  376.  
  377. GetColorPalete:
  378.    colorlist = GetColorList()
  379.  
  380.    if  ~(colorlist = '') then do
  381.        count = 1
  382.        pos   = index(colorlist, cr)
  383.  
  384.        do while pos > 0
  385.           count = count + 1
  386.           pos   = index(colorlist, cr, pos + 1)
  387.           end
  388.        end
  389.        else
  390.           exit_msg(Color palatte not found)
  391.  return
  392.  
  393.  
  394. exit_msg: /*procedure expose units */
  395. do
  396.     parse arg message
  397.     if message ~= '' then
  398.         call pdm_Inform(1, message,)
  399.     call pdm_ClearStatus()
  400.     exit
  401. end
  402.  
  403.